-- | Buffers.hs
-- A module for initialize, read, update and destroy buffers
-- (structures which contain text and info about opened rooms
-- and privates).

module Buffers where

import Network.XMPP

import Control.Concurrent
import qualified Data.HashTable as H
import Data.IORef
import Data.List
import Data.Maybe
import Control.Monad
import Control.Monad.Error

type Accounts = H.HashTable String Account
type Users = H.HashTable String User
data User = UserChat Chat | UserGroupchat Groupchat | UserRosterItem RosterItem | UserGroup Group

class RosterElement a where
    contents :: a -> [Content]
    getAlert :: a -> AlertStatus
    setAlert :: a -> AlertStatus -> a
    contents a = []
    getAlert a = AlertNone
    setAlert a _ = a

class (RosterElement a) => BufferElement a where
    getBufferAccount :: a -> Maybe Account
    getBufferName :: a -> Maybe String
    getBufferAlert :: a -> AlertStatus
    getBufferAccount a = Nothing
    getBufferName a = Nothing
    getBufferAlert a = AlertNone

data Account = Account
    { username :: String
    , server :: String
    , password :: String
    , resource :: String
    , priority :: Integer
    , defaultNick :: String
    , connection :: Maybe (TCPConnection, ThreadId)
    , users :: Users
    , accountContents :: [Content]
    }

instance Show Account where
    show acc = "Account: " ++ (username acc) ++ "@" ++ (server acc) ++ "/" ++ (resource acc)

instance RosterElement Account where
    contents = accountContents

data Chat = Chat
    { chatContents :: [Content]
    }

instance RosterElement Chat where
    contents = chatContents

data Group = Group
	{
		groupItems :: Users
		,groupCollapsed :: Bool
	}

instance RosterElement Group

data Groupchat = Groupchat
    { groupchatContents :: [Content]
    , groupchatNick :: String
    , subchats :: Subchats
    , groupchatAlert :: AlertStatus
    }

instance RosterElement Groupchat where
    contents = groupchatContents
    getAlert = groupchatAlert
    setAlert x s = x { groupchatAlert = s }

type Subchats = H.HashTable String Subchat
data Subchat = Subchat
    { subchatContents :: [Content]
    }

instance RosterElement Subchat where
    contents = subchatContents

data RosterItem = RosterItem
	{
		itemJid :: String
		,itemName :: String
		,itemGroups :: [String]
		,itemContents :: [Content]
		,itemStatus :: RosterItemStatus
		,itemAlert :: AlertStatus
	}

instance RosterElement RosterItem where
    contents = itemContents
    getAlert = itemAlert
    setAlert x s = x { itemAlert = s }

data AlertStatus = AlertNone
                 | AlertNotify
                 | AlertUrgent
                   deriving Eq
				 
data RosterItemStatus = StatusOffline (Maybe String)
	    | StatusOnline (Maybe String)
	    | StatusAway (Maybe String)
	    | StatusChat (Maybe String)
	    | StatusDND (Maybe String)
	    | StatusXA (Maybe String)

statusToString status = case status of
    (StatusOffline s) -> ("offline", s)
    (StatusOnline s) -> ("online", s)
    (StatusAway s) -> ("away", s)
    (StatusChat s) -> ("chat", s)
    (StatusDND s) -> ("dnd", s)
    (StatusXA s) -> ("xa", s)
    _ -> ("offline", Nothing)

data Content = Msg String
             | MyMsg String
             | HistoryMsg String
             | UnknownMsg String
               deriving (Eq, Show)

-- | Unique pointer on buffer.
data Buffer = BufferHelp [Content]
            | BufferAccount String Account
            | BufferGroup     Buffer String
            | BufferChat      Buffer String Chat
            | BufferGroupchat Buffer String Groupchat
            | BufferRosterItem Buffer String RosterItem
            | BufferSubchat   Buffer Buffer String Subchat
            | Empty

instance RosterElement Buffer where
    contents (BufferHelp cnt) = cnt
    contents (BufferAccount _ acc) = contents acc
    contents (BufferChat _ _ acc) = contents acc
    contents (BufferGroup _ _) = []
    contents (BufferGroupchat _ _ acc) = contents acc
    contents (BufferRosterItem _ _ acc) = contents acc
    contents (BufferSubchat _ _ _ acc) = contents acc
    contents _ = []

instance BufferElement Buffer where
    getBufferAccount (BufferAccount _ acc) = Just acc
    getBufferAccount (BufferChat acc _ _) = getBufferAccount acc
    getBufferAccount (BufferGroup acc _ ) = getBufferAccount acc
    getBufferAccount (BufferGroupchat acc _ _) = getBufferAccount acc
    getBufferAccount (BufferRosterItem acc _ _) = getBufferAccount acc 
    getBufferAccount (BufferSubchat acc _ _ _) = getBufferAccount acc

    getBufferName (BufferAccount name _) = Just name
    getBufferName (BufferChat _ name _) = Just name
    getBufferName (BufferGroup _ name ) = Just name
    getBufferName (BufferGroupchat _ name _) = Just name
    getBufferName (BufferRosterItem _ name _) = Just name
    getBufferName (BufferSubchat _ _ name _) = Just name

    getBufferAlert (BufferGroupchat _ _ gc) = getAlert gc
    getBufferAlert (BufferRosterItem _ _ ri) = getAlert ri
    getBufferAlert _ = AlertNone

-- | Buffers equal if their names equal (contents may change).
instance Eq Buffer where
    BufferHelp cnt == BufferHelp cnt' =
        cnt == cnt'
    BufferAccount name _ == BufferAccount name' _ =
        name == name'
    BufferGroup acc name == BufferGroup acc' name' =
        name == name' && acc == acc'
    BufferChat acc name _ == BufferChat acc' name' _ =
        name == name' && acc == acc'
    BufferGroupchat acc name _ == BufferGroupchat acc' name' _ =
        name == name' && acc == acc'
    BufferRosterItem acc name _ == BufferRosterItem acc' name' _ =
        name == name' && acc == acc'
    BufferSubchat acc grp name _ == BufferSubchat acc' grp' name' _ =
        name == name' && grp == grp' && acc == acc'
    _ == _ = False

-- | Buffers equal if their names equal (contents may change).
instance Show Buffer where
    show (BufferHelp cnt) = show cnt
    show (BufferAccount name _) = "Account: " ++ name
    show (BufferGroup acc name) = (show acc) ++ " -> Group " ++ name
    show (BufferChat acc name _) = (show acc) ++ " -> Chat " ++ name
    show (BufferGroupchat acc name _) = (show acc) ++ " -> GroupChat " ++ name
    show (BufferRosterItem acc name _) = (show acc) ++ " -> RosterItem " ++ name
    show (BufferSubchat acc grp name _) = (show grp) ++ " -> SubChat " ++ name
    show _ = "Unknown Buffer"

-- | Status to show in status line (error or info).
data StatusResult a = StatusResult (Either String (a, String))
data Status = StatusError String | StatusInfo String

groupList :: [(String, User)] -> [String]
groupList userlst = nub $ concat $ map (\user ->
		case snd user of
			UserRosterItem item -> itemGroups item
			_ -> []
		) userlst

groupedUsers :: [String] -> [(String, User)] -> [(String, [(String, User)])]
groupedUsers [] items = let
	bygroup = filter (\item -> do
		case snd item of
			UserRosterItem item ->
				False
			_ ->
				True 
			) items in
	(" Runtime ", bygroup):[]

groupedUsers (group:groups) items = let
	bygroup = filter (\item -> do
		case snd item of
			UserRosterItem item ->
				if elem group $ itemGroups item then
					True
				else
					False
			_ ->
				False 
			) items in
	((group, bygroup):(groupedUsers groups items))

-- | Convert hashtables to list.
getBuffersList :: Accounts -> IORef [Content] -> IO [Buffer]
getBuffersList accounts help = do
    accountsList <- H.toList accounts
    helpCnt <- readIORef help
    liftM ((:) (BufferHelp helpCnt) . concat) $
		forM accountsList $ \account -> do
			let acc = BufferAccount (fst account) (snd account)
			usersList <- H.toList (users $ snd account)
			groups <- return $ groupList $ usersList
			groups' <- return $ sortBy (\g1 g2 -> compare (fst g1) (fst g2)) $ groupedUsers groups usersList
			users' <- forM groups' $ \group -> do
				liftM ((:) (BufferGroup acc (fst group)) . concat) $
					forM (snd group) $ \user -> do
						case snd user of
							UserChat chat ->
							  return [BufferChat acc (fst user) chat]
							UserRosterItem item ->
							  return [BufferRosterItem acc (fst user) item]
							UserGroupchat groupchat -> do
							  let groupchat' = BufferGroupchat acc (fst user) groupchat
							  subchats' <- H.toList (subchats groupchat)
							  return $ groupchat':
								   (map (\(name,value) ->
									 BufferSubchat acc groupchat' name value) subchats')
			return $ acc:(concat $ users')
-- | Get value from hashtable.
getHashValue :: H.HashTable String b -> String -> IO (StatusResult (String, b))
getHashValue hashTable name = do
    value <- H.lookup hashTable name
    return $ case value of
      Just value -> StatusResult $ Right ((name, value), "")
      _ -> StatusResult $ Left $ name++" not found in hashtable"

-- | Save account by name to hashtable.
putAccount :: Accounts -> (String, Account) -> IO (StatusResult a)
putAccount accounts (name, account) = do
    H.update accounts name account
    return $ StatusResult $ Right (undefined, name++" updated")
